home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Developer's Kit 1996
/
Delphi Developer's Kit 1996.iso
/
power
/
reswtch2
/
reswatch.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-12-22
|
20KB
|
594 lines
{ ----------------------------------------------------------------------------}
{ ResWatch Resource Watcher Version 2.0. }
{ Copyright 1995, Curtis White. All Rights Reserved. }
{ This program can be freely used and distributed in commercial and private }
{ environments, provied this notice is not modified in any way. }
{ ----------------------------------------------------------------------------}
{ Feel free to contact me if you have any questions, comments or suggestions }
{ at cwhite@teleport.com }
{ ----------------------------------------------------------------------------}
{ Date last modified: 08/03/95 }
{ ----------------------------------------------------------------------------}
{ ----------------------------------------------------------------------------}
{ ResWatch v2.00 }
{ ----------------------------------------------------------------------------}
{ Description: }
{ A graphical resource monitor }
{ Features: }
{ Monitor system resources. }
{ Monitor other system information. }
{ ----------------------------------------------------------------------------}
{ ----------------------------------------------------------------------------}
{ Revision History: }
{ 1.00: Initial release }
{ 2.00: Re-write to add more functionality as well }
{ as a nicer look. }
{ ----------------------------------------------------------------------------}
{ Note: This program uses a component that I wrote to }
{ obtain a bunch of system information. I will be }
{ releasing this component as soon as I finish the }
{ documentation for it. Keep watching. }
{ Note2: This program may need modifications to run }
{ properly under Windows 95, since some of the }
{ resource calls may have been changed. }
unit Reswatch;
{
TForm3D Class
Copyright ⌐ 1995 Alan Ciemian All Rights Reserved
The TForm3D class is a descendant of TForm that provides
3D borders for non-dialog forms and allows form sizing to be
enabled/disabled by modifying a run-time property.
NOTES:
- Requires that form have bsSizeable border style.
- Sizing can be enabled/disabled with AllowResize property.
- Handles all Title bar icon combinations.
- Handles forms with or without menus(including multiline).
- Handles all combinations of scroll bars.
05/01/95 - Initial Release
}
interface
uses
Messages, WinTypes,
Classes, Controls, Forms, Dialogs, Sysinfo, ExtCtrls, Gauges, StdCtrls,
Buttons, SysUtils, RWAbout;
const
CaptionH_STD = 20;
MenuH_STD = 18;
type
TForm3D_NCPaintMode =
(
NCPaint_All,
NCPaint_Activate,
NCPaint_Deactivate
);
type
TRWMain = class(TForm)
RWMainPanel: TPanel;
FreeMemLabel: TLabel;
FreeMemSize: TLabel;
ContigFreeLabel: TLabel;
ContigFreeSize: TLabel;
Panel4: TPanel;
Panel5: TPanel;
SystemPanel: TPanel;
SystemGauge: TGauge;
GDIPanel: TPanel;
GDIGauge: TGauge;
UserPanel: TPanel;
UserGauge: TGauge;
Panel6: TPanel;
CPULabel: TLabel;
WinVerLabel: TLabel;
DosVerLabel: TLabel;
TasksLabel: TLabel;
ResourceTimer: TTimer;
SystemInfo1: TSystemInfo;
AboutButton: TBitBtn;
procedure ResourceTimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure AboutButtonClick(Sender: TObject);
private
FAllowResize : Boolean;
FSysMenuW : Integer; { Width of system menu, 0 if no sysmenu }
FMinMaxW : Integer; { Width of min/max buttons, 0 if no min/max btns }
{ Private procedures }
procedure NCPaint3D(const Mode: TForm3D_NCPaintMode);
procedure ComputeNonClientDimensions;
function ScrollBarVisible
(
const Code : Word; { SB_VERT or SB_HORZ }
const WndRect : TRect
): Boolean;
{ Message Handlers }
procedure WMNCHitTest (var Msg: TWMNCHitTest); message WM_NCHitTest;
procedure WMNCPaint (var Msg: TWMNCPaint); message WM_NCPaint;
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCActivate;
protected
procedure CreateWnd; override;
public
constructor Create(AOwner: TComponent); override;
{ Properties }
property AllowResize: Boolean
read FAllowResize
write FAllowResize
default False;
end;
var
RWMain: TRWMain;
implementation
{$R *.DFM}
uses
WinProcs,
Graphics,
SysMet;
function TRWMain.ScrollBarVisible
(
const Code : Word; { SB_VERT or SB_HORZ }
const WndRect : TRect
): Boolean;
var
PtInScroll : TPoint;
HVis : Boolean;
begin
Result := False;
with WndRect, SysMetrics do
begin
{ Determine if Horz scroll bar is visible. Need this for both horz and }
{ vert scroll bars. }
{ Two checks need to be satisfied, Style identifies scroll bar and }
{ windows recognizes HitTest in scroll bar. }
{ Hit Test check is required because there are cases when the window }
{ gets very small that windows decides not to draw the scroll bars }
{ even though they exist. }
PtInScroll := Point(Left + Frame.cx + 1, Bottom - Frame.cy - 1);
HVis := ( ((GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL) <> 0) and
(Perform(WM_NCHITTEST, 0, LongInt(PtInScroll)) = HTHSCROLL) );
if ( Code = SB_HORZ ) then
begin { Done, return result computed above }
Result := HVis;
end
else
begin { Perform same procedure as above for vertical }
PtInScroll := Point(Right - Frame.cx - 1, Bottom - Frame.cy - 1);
if ( HVis ) then Dec(PtInScroll.y, HScrollBtn.cy);
Result := ( ((GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL) <> 0) and
(Perform(WM_NCHITTEST, 0, LongInt(PtInScroll)) = HTVSCROLL) );
end;
end;
end;
constructor TRWMain.Create
(
AOwner: TComponent
);
begin
inherited Create(AOwner);
{ Set property defaults }
FAllowResize := False;
end;
{
CreateWnd is overriden so we can force certain properties before
the window is created, and compute some parameters needed to
do the 3D non-client drawing.
}
procedure TRWMain.CreateWnd;
var
AdjustHeight : Integer;
begin
{ Border Style must be bsSizeable }
BorderStyle := bsSizeable;
{ Compute height adjustments for font caption and menu. }
{ In large fonts video modes the client area would otherwise }
{ be reduced. }
AdjustHeight := 0;
with SysMetrics do
begin
Inc(AdjustHeight, CaptionH - CaptionH_STD);
{ Note: Only adjusts for a single line menu bar }
if ( Menu <> nil ) then Inc(AdjustHeight, MenuH - MenuH_STD);
end;
{ Let Form create }
inherited CreateWnd;
{ Enforce the height adjustment }
Height := Height + AdjustHeight;
{ Precompute dimensions of key non-client areas for later use }
{ in drawing the 3D effects. }
ComputeNonClientDimensions;
end;
{
ComputeNonClientDimensions precomputes some dimensions of non-client items
to avoid doing it repeatedly during painting.
}
procedure TRWMain.ComputeNonClientDimensions;
{ We'd like to use the SM_CXSIZE system metrics value for the size of icons }
{ in the title bar but it is NOT correct for some video drivers/modes }
function BitmapWidth(const BM_ID: Integer): Integer;
var
BM : THandle;
BMInfo : WinTypes.TBitmap;
begin
BM := LoadBitmap(0, MakeIntResource(BM_ID));
try
GetObject(BM, SizeOf(BMInfo), @BMInfo);
Result := BMInfo.bmWidth;
finally
DeleteObject(BM);
end;
end;
begin
FSysMenuW := 0;
if ( biSystemMenu in BorderIcons ) then
begin
{ Note: Close bitmap contains 2 bitmaps, app close and MDI child close }
Inc(FSysMenuW, BitmapWidth(OBM_CLOSE) div 2);
end;
FMinMaxW := 0;
if ( biMinimize in BorderIcons ) then
begin
Inc(FMinMaxW, BitmapWidth(OBM_REDUCE));
end;
if ( biMaximize in BorderIcons ) then
begin
Inc(FMinMaxW, BitmapWidth(OBM_ZOOM));
end;
end;
{
NCPaint3D handles the 3D specific painting for the form.
}
procedure TRWMain.NCPaint3D
(
const Mode: TForm3D_NCPaintMode
);
var
WndRect : TRect;
ClientRect : TRect;
ClientH : Integer;
ScrollH : Integer;
DC : HDC;
NCCanvas : TCanvas;
Extra : Integer;
CaptionRect : TRect;
TM : TTextMetric;
begin
{ Get window rect }
WinProcs.GetWindowRect(Handle, WndRect);
{ Need to know if horz scroll bar present }
ScrollH := 0;
if ( ScrollBarVisible(SB_HORZ, WndRect) ) then
begin
ScrollH := SysMetrics.HScrollBtn.cy - 1;
end;
{ Convert window rect to (0, 0) origin }
with WndRect do
begin
Right := Right - Left;
Left := 0;
Bottom := Bottom - Top;
Top := 0;
end;
WinProcs.GetClientRect(Handle, ClientRect);
ClientH := ClientRect.Bottom - ClientRect.Top;
if ( 0 < ClientH ) then Inc(ClientH);
{ Get a Window DC and wrap it in a Delphi Canvas }
DC := GetWindowDC(Self.Handle);
NCCanvas := TCanvas.Create;
NCCanvas.Handle := DC;
try
with NCCanvas, WndRect, SysMetrics do
begin
if ( Mode = NCPaint_All ) then
begin
{ Draw Left and Top edges of window frame, outer }
Pen.Color := clBtnShadow;
PolyLine([ Point(Left, Bottom - 1),
Point(Left, Top),
Point(Right, Top) ]);
{ Draw Bottom and Right edges of window frame, outer }
Pen.Color := clWindowFrame;
PolyLine([ Point(Left, Bottom - 1),
Point(Right - 1, Bottom - 1),
Point(Right - 1, Top - 1) ]);
{ Draw Left and Top edges of window frame, 1-pixel in }
Pen.Color := clBtnHighlight;
PolyLine([ Point(Left + 1, Bottom - 2),
Point(Left + 1, Top + 1),
Point(Right - 1, Top + 1) ]);
{ Draw Right and Bottom edges of window frame, 1-pixel in }
Pen.Color := clBtnShadow;
PolyLine([ Point(Left + 1, Bottom - 2),
Point(Right - 2, Bottom - 2),
Point(Right - 2, Top) ]);
{ Fill Remainder of Sizing border }
Pen.Color := clBtnFace;
for Extra := 2 to (Frame.cx - 1) do
begin
Brush.Color := clBtnFace;
FrameRect(Rect(Left + Extra, Top + Extra,
Right - Extra, Bottom - Extra));
end;
{ Draw Left and Top Edge of Caption Area }
Pen.Color := clBtnShadow;
PolyLine([ Point(Frame.cx - 1, Bottom - 1 - Frame.cy - ClientH - ScrollH),
Point(Frame.cx - 1, Frame.cy - 1),
Point(Right - Frame.cx, Frame.cy - 1) ]);
{ Draw Bottom and Right Edge of Caption Area }
Pen.Color := clBtnHighlight;
PolyLine([ Point(Frame.cx - 1, Bottom - Frame.cy - ClientH - ScrollH),
Point(Right - Frame.cx, Bottom - Frame.cy - ClientH - ScrollH),
Point(Right - Frame.cx, Frame.cy - 1) ]);
end;
{ Draw Caption }
CaptionRect := Rect(Frame.cx + FSysMenuW + 1, Frame.cy,
Right - Frame.cx - FMinMaxW,
Frame.cy - 1 + CaptionH - 1);
if ( (Mode = NCPaint_Activate) or
((Mode = NCPaint_All) and (GetActiveWindow = Self.Handle)) ) then
begin { Need 'Active' Caption }
Brush.Color := clActiveCaption;
Font.Color := clCaptionText;
end
else
begin { Need 'InActive' Caption }
Brush.Color := clInactiveCaption;
Font.Color := clInactiveCaptionText;
end;
FillRect(CaptionRect);
SetTextAlign(DC, TA_CENTER or TA_TOP);
GetTextMetrics(DC, TM);
TextRect(CaptionRect,
(CaptionRect.Left + CaptionRect.Right) div 2,
CaptionRect.Top + ((CaptionH - 1) - TM.tmHeight) div 2,
Caption);
end;
finally
NCCanvas.Free;
ReleaseDC(Handle, DC);
end; { try-finally }
end;
{
WMNCHitTest handles the WM_NCHITTEST message.
Modifies sizing hit codes to support fixed size windows.
}
procedure TRWMain.WMNCHitTest
(
var Msg: TWMNCHitTest
);
var
HitCode : LongInt;
begin
inherited;
HitCode := Msg.Result;
{ Lets resurrect the size corner }
if ( HitCode = HTSIZE ) then HitCode := HTBOTTOMRIGHT;
if ( not AllowResize ) then
begin
if ( (HitCode = HTLEFT) or (HitCode = HTRIGHT) or
(HitCode = HTTOP) or (HitCode = HTBOTTOM) or
(HitCode = HTTOPLEFT) or (HitCode = HTBOTTOMLEFT) or
(HitCode = HTTOPRIGHT) or (HitCode = HTBOTTOMRIGHT) ) then
begin
HitCode := HTNOWHERE;
end;
end;
Msg.Result := HitCode;
end;
{
WMNCPaint handles WM_NCPAINT message.
Calls default handler to paint non-client areas that have standard appearance.
Calls NCPaint3D to paint modified non-client areas
NOTE: Uses undocumented aspect of WM_NCPAINT message which allows a clipping
region handle to be passed in the wParam of the message.
This is used to avoid seeing the standard non-client areas flash before
they are repainted by the 3D code.
Ref. Undocumented Windows pg. 527, Thanks Andrew.
}
procedure TRWMain.WMNCPaint
(
var Msg: TWMNCPaint
);
var
WndRect : TRect;
ClientRect : TRect;
ClientH : Integer;
ScrollH : Integer;
ClipRect : TRect;
ClipRgn : THandle;
HScrollVis : Boolean;
VScrollVis : Boolean;
begin
{ Let Windows draw the non-client areas that will not change }
{ Form props for window pos and size incorrect during resize here. }
{ Get Position directly from windows }
WinProcs.GetWindowRect(Handle, WndRect);
WinProcs.GetClientRect(Handle, ClientRect);
ClientH := ClientRect.Bottom - ClientRect.Top;
if ( 0 < ClientH ) then Inc(ClientH);
HScrollVis := ScrollBarVisible(SB_HORZ, WndRect);
VScrollVis := ScrollBarVisible(SB_VERT, WndRect);
ScrollH := 0;
if ( HScrollVis ) then ScrollH := SysMetrics.HScrollBtn.cy - 1;
with WndRect, SysMetrics do
begin
{ System Menu }
if ( biSystemMenu in BorderIcons ) then
begin
ClipRect := Rect(Left + Frame.cx, Top + Frame.cy,
Left + Frame.cx + TitleBitmap.cx + 1,
Top + Frame.cy + TitleBitmap.cy);
ClipRgn := CreateRectRgnIndirect(ClipRect);
TMessage(Msg).wParam := ClipRgn;
(self as TWinControl).DefaultHandler(Msg);
DeleteObject(ClipRgn);
end;
{ Min/Max buttons }
if ( 0 < FMinMaxW ) then
begin
ClipRect := Rect(Right - Frame.cx - FMinMaxW, Top + Frame.cy,
Right - Frame.cx, Top + Frame.cy + TitleBitmap.cy);
ClipRgn := CreateRectRgnIndirect(ClipRect);
TMessage(Msg).wParam := ClipRgn;
(self as TWinControl).DefaultHandler(Msg);
DeleteObject(ClipRgn);
end;
{ Menubar }
if ( Menu <> nil ) then
begin
ClipRect := Rect(Left + Frame.cx, Top + Frame.cy + CaptionH - Border.cy - 1,
Right - Frame.cx, Bottom - Frame.cy - ClientH - ScrollH);
ClipRgn := CreateRectRgnIndirect(ClipRect);
TMessage(Msg).wParam := ClipRgn;
(self as TWinControl).DefaultHandler(Msg);
DeleteObject(ClipRgn);
end;
end;
{ Paint 3-D parts of nonclient area in 3-D style }
NCPaint3D(NCPaint_All);
{ Now let windows paint scroll bars. Need to wait until here because scroll }
{ bars take advantage of normal borders for their outer edges and they }
{ our trounced in NCPaint3D. }
with WndRect, SysMetrics do
begin
if ( HScrollVis ) then
begin { Let Windows draw horz scroll bar }
ClipRect := Rect(Left + (Frame.cx - 1), Bottom - (Frame.cy - 1) - HScrollBtn.cy,
Right - (Frame.cx - 1), Bottom - (Frame.cy - 1));
if ( VScrollVis ) then Dec(ClipRect.Right, VScrollBtn.cx - 1);
ClipRgn := CreateRectRgnIndirect(ClipRect);
TMessage(Msg).wParam := ClipRgn;
(self as TWinControl).DefaultHandler(Msg);
DeleteObject(ClipRgn);
end;
if ( VScrollVis ) then
begin { Let Windows draw vert scroll bar }
ClipRect := Rect(Right - (Frame.cx - 1) - VScrollBtn.cx, Bottom - Frame.cy - ClientH - ScrollH,
Right - (Frame.cx - 1), Bottom - (Frame.cy - 1));
if ( HScrollVis ) then Dec(ClipRect.Bottom, HScrollBtn.cy - 1);
ClipRgn := CreateRectRgnIndirect(ClipRect);
TMessage(Msg).wParam := ClipRgn;
(self as TWinControl).DefaultHandler(Msg);
DeleteObject(ClipRgn);
end;
if ( HScrollVis and VScrollVis ) then
begin { Let Windows draw little box in corner }
ClipRect := Rect(Right - (Frame.cx - 1) - (VScrollBtn.cx - 1),
Bottom - (Frame.cy - 1) - (HScrollBtn.cy - 1),
Right - (Frame.cx - 1) - 1, Bottom - (Frame.cy - 1) - 1);
ClipRgn := CreateRectRgnIndirect(ClipRect);
TMessage(Msg).wParam := ClipRgn;
(self as TWinControl).DefaultHandler(Msg);
DeleteObject(ClipRgn);
end;
end;
{ Now let windows update scroll bars }
Msg.Result := 0;
end;
{
WMNCActivate handles the WM_NCACTIVATE message.
Calls NCPaint3D to repaint the caption.
Can NOT let windows have this message or it will trash our 3D borders.
}
procedure TRWMain.WMNCActivate
(
var Msg: TWMNCActivate
);
begin
if ( Msg.Active ) then
NCPaint3D(NCPaint_Activate)
else
NCPaint3D(NCPaint_Deactivate);
Msg.Result := 1;
end;
procedure TRWMain.ResourceTimerTimer(Sender: TObject);
begin
UserGauge.Progress := SystemInfo1.PcntFreeUserRes;
GDIGauge.Progress := SystemInfo1.PcntFreeGDIRes;
SystemGauge.Progress := SystemInfo1.PcntFreeSystemRes;
FreeMemSize.Caption := IntToStr(SystemInfo1.FreeHeap)+' bytes';
ContigFreeSize.Caption := IntToStr(SystemInfo1.ContigFreeHeap)+' bytes';
CPULabel.Caption := 'CPU: '+ SystemInfo1.CPUString;
WinVerLabel.Caption := 'Win Ver: '+ SystemInfo1.WindowsVersion;
DosVerLabel.Caption := 'Dos Ver: '+ SystemInfo1.DOSVersion;
TasksLabel.Caption := 'Tasks: '+ IntToStr(SystemInfo1.TasksRunning);
end;
procedure TRWMain.FormCreate(Sender: TObject);
var
hMenu: THandle;
begin
Application.HintColor := clAqua;
Application.HintPause := 0;
hMenu := GetSystemMenu(Handle, False);
DeleteMenu(hMenu, 4, MF_BYPOSITION);
DeleteMenu(hMenu, 2, MF_BYPOSITION);
DeleteMenu(hMenu, 0, MF_BYPOSITION);
AboutButton.Caption := '';
end;
procedure TRWMain.AboutButtonClick(Sender: TObject);
begin
RWAboutBox.Show;
end;
end.